home *** CD-ROM | disk | FTP | other *** search
/ Almathera Ten Pack 3: CDPD 3 / Almathera Ten on Ten - Disc 3: CDPD3.iso / scope / 126-150 / scopedisk133 / basprghelp / intuits.sub < prev    next >
Encoding:
Text File  |  1995-03-19  |  10.6 KB  |  372 lines
  1. 'Subroutines for creating gadgets and requestors without using
  2. 'Amiga intuition.
  3. REM SimpleRequest
  4. 'Simple requestor box
  5. 'x%, y% = x and y offsets in lines
  6. 'msg$ = single line of text for message
  7. 'oktxt$, cantxt$ = OK and CANCEL button text
  8. SUB SimpleRequest(x%,y%,msg$,oktxt$,cantxt$)
  9.     SHARED maxlen%,ScrID%,which%,BoxIndex%
  10.     height%=PEEKW(WINDOW(8)+58)
  11.     winwidth%=maxlen%*(8-2*(height%=9))+40
  12.     COLOR 2,0,0
  13.     LINE (x%+3,y%+1)-(winwidth%+x%,30+y%),1,bf
  14.     LINE (x%+3,y%+1)-(winwidth%+x%,30+y%),2,b
  15.     LINE (x%,y%)-(winwidth%+x%+3,31+y%),3,b
  16.     PRINT PTAB(x%+(winwidth%-LEN(msg$)*8)/2,y%+10); " ";msg$
  17.     PRINT PTAB(x%,y%+24)
  18.     PRINT " ";
  19.     CALL SmallTxBox(oktxt$)
  20.     PRINT PTAB(x%+winwidth%-(LEN(cantxt$)+2)*8-6,y%+24);
  21.     CALL SmallTxBox(cantxt$)
  22.     COLOR 1,0,1
  23. END SUB
  24. REM SmallTxBox
  25. 'Gadget box with text in msg$
  26. SUB SmallTxBox(msg$) STATIC
  27.     SHARED x1%(),y1%(),x2%(),y2%()
  28.     SHARED BoxIndex%
  29.     x1%=WINDOW(4) : y1%=WINDOW(5)-8
  30.     PRINT " ";msg$;" ";
  31.     x2%=WINDOW(4) : y2%=y1%+11
  32.     CALL Box(BoxIndex%,x1%,y1%,x2%,y2%)
  33.     BoxIndex%=BoxIndex%+1
  34.     PRINT SPC(1);
  35. END SUB
  36. REM SmallTxGad
  37. 'Text gadget without a box
  38. SUB SmallTxGad(msg$) STATIC
  39.     SHARED x1%(),y1%(),x2%(),y2%()
  40.     SHARED BoxIndex%
  41.     x1%=WINDOW(4) : y1%=WINDOW(5)-7
  42.     PRINT " ";msg$;" ";
  43.     x2%=WINDOW(4) : y2%=y1%+10
  44.     CALL NoBoxGad(BoxIndex%,x1%,y1%,x2%,y2%)
  45.     BoxIndex%=BoxIndex%+1
  46.     PRINT SPC(1);
  47. END SUB
  48. REM NewStringRequest
  49. 'String requestor
  50. 'default$ = returned string, can also contain a default string
  51. SUB NewStringRequest(x%,y%,msg$,default$) STATIC
  52.     SHARED maxlen%,ScrID%,which%,BoxIndex%
  53.     height%=PEEKW(WINDOW(8)+58)
  54.     winwidth%=maxlen%*(8-2*(height%=9))+40
  55.     COLOR 2,0,0
  56.     LINE (x%+3,y%+1)-(winwidth%+x%,29+y%),1,bf
  57.     LINE (x%+3,y%+1)-(winwidth%+x%,29+y%),2,b
  58.     LINE (x%,y%)-(winwidth%+x%+3,30+y%),3,b
  59.     PRINT PTAB(x%+10,y%+13);msg$
  60.     PRINT PTAB(x%+10,y%+24);
  61.     COLOR 1,0,1
  62.     CALL SmallTxBox(default$+SPACE$(1+maxlen%-LEN(default$))) 'reserve space
  63.     Xpos%=x%+8 : Ypos%=y%+24 'for GetString
  64.     CALL GetString(Xpos%,Ypos%,default$)
  65. END SUB
  66. REM StringRequest
  67. 'Same as above, but more configurable
  68. 'title$ = requestor title string
  69. 'msg$ = requestor message
  70. 'b1$, b2$ = OK and CANCEL button text
  71. SUB StringRequest(x%,y%,title$,msg$,b1$,b2$,default$) STATIC
  72.     SHARED maxlen%,ScrID%,which%,BoxIndex%
  73.     BoxIndex%=1
  74.     height%=PEEKW(WINDOW(8)+58)
  75.     winwidth%=maxlen%*(8-2*(height%=9))+40
  76.     COLOR 2,0,0
  77.     LINE (x%+3,y%+1)-(winwidth%+x%,54+y%),1,bf
  78.     LINE (x%+3,y%+1)-(winwidth%+x%,54+y%),2,b
  79.     LINE (x%,y%)-(winwidth%+x%+3,55+y%),3,b
  80.     COLOR 0,0,0
  81.     PRINT PTAB(x%+(winwidth%-LEN(title$))*8/2,y%+10);title$
  82.     COLOR 2,0,0
  83.     PRINT PTAB(x%+8,y%+20);msg$
  84.     PRINT PTAB(x%+8,y%+32);
  85.     COLOR 1,0,1
  86.     CALL SmallTxBox(default$+SPACE$(1+maxlen%-LEN(default$))) 'reserve space
  87.     Xpos%=x%+8 : Ypos%=y%+32 'for GetString
  88.     COLOR 2,0,0
  89.     PRINT PTAB(x%+8,y%+48) : CALL SmallTxBox(b1$)
  90.     PRINT PTAB(x%+winwidth%-(LEN(b2$)+2)*8-6,y%+48) : CALL SmallTxBox(b2$)
  91.     COLOR 1,0,1
  92.     which%=0
  93.     WHILE which%<=1
  94.           CALL WaitBox(which%) 'Get box #
  95.           IF which%=1 THEN 'if GetString
  96.                 CALL GetString(Xpos%,Ypos%,default$)
  97.           END IF
  98.     WEND 'must be Open or Cancel
  99.     CALL FlashRelease(which%) 'Flash the box
  100.     IF which%=BoxIndex%-1 THEN default$=""
  101. END SUB
  102.  
  103.  
  104. REM EasyAlert
  105. 'An Alert requestor with two lines of text, msg1$ and msg2$
  106. 'Buttons are pre-set to Continue and Abort
  107. 'which% = returns 1 for continue and 2 for abort
  108. SUB EasyAlert(msg1$,msg2$,which%) STATIC
  109. 'Easy Alert.  Pass two lines of text
  110. 'in msg1$,msg2$.  Receive button status
  111. '(1=retry, 2=cancel) in (which%)
  112.     CALL EasyRequest(msg1$,msg2$,"Continue","Abort",which%)
  113. END SUB
  114.  
  115. REM EasyRequest
  116. 'Same as above, but can configure buttons with b1$ and b2$ text
  117. SUB EasyRequest(msg1$,msg2$,b1$,b2$,which%) STATIC
  118. 'Generalized requester
  119. 'Pass two messages lines in msg1$,msg2$
  120. 'and two button prompts in b1$,b2$
  121. 'Confine text to a width of 16
  122. ' button (usually Cancel)
  123. 'No buttons are highlighted
  124.     SHARED BoxIndex%,ScrID%
  125.     SHARED x1%(),y1%(),x2%(),y2%()
  126.     BoxIndex%=1
  127.     height%=PEEKW(WINDOW(8)+58)
  128.     winwidth%=20*(8-2*(height%=9))+30
  129.     WINDOW 2,"System Request",(0,0)-(winwidth%,50),0,ScrID%
  130.     PRINT : PRINT TAB(11-LEN(msg1$)/2);msg1$
  131.     PRINT TAB(11-LEN(msg2$)/2);msg2$ : PRINT        
  132.     LOCATE ,2
  133.     TxBox b1$
  134.     PRINT TAB(20-LEN(b2$));
  135.     TxBox b2$
  136.     which%=0
  137.     CALL WaitBox(which%)
  138.     CALL FlashRelease(which%)
  139.     WINDOW CLOSE 2
  140. END SUB
  141. REM OneButtonRequest
  142. 'Same as above, but with one button rather than two
  143. SUB OneButtonRequest(msg1$,msg2$,b1$,which%) STATIC
  144.     SHARED BoxIndex%,ScrID%
  145.     SHARED x1%(),y1%(),x2%(),y2%()
  146.     BoxIndex%=1
  147.     height%=PEEKW(WINDOW(8)+58)
  148.     winwidth%=20*(8-2*(height%=9))+30
  149.     WINDOW 2,"System Request",(0,0)-(winwidth%,45),0,ScrID%
  150.     PRINT : PRINT TAB(11-LEN(msg1$)/2);msg1$
  151.     PRINT TAB(11-LEN(msg2$)/2);msg2$ : PRINT        
  152.     LOCATE ,(20-LEN(b1$))/2
  153.     TxBox b1$
  154.     which%=0
  155.     CALL WaitBox(which%)
  156.     CALL FlashRelease(which%)
  157.     WINDOW CLOSE 2
  158. END SUB
  159.  
  160. REM FlashRelease
  161. SUB FlashRelease(which%) STATIC
  162. 'Flashes button (which%), waits for
  163. 'release of mouse button
  164. 'if mouse moved during release,
  165. 'global variable RelVerify is set to null,
  166. 'else is -1 (true).
  167.     SHARED x1%(),y1%(),x2%(),y2%(),work%()
  168.     SHARED RelVerify%
  169.     'These two lines flash the box
  170.     GET (x1%(which%),y1%(which%))-(x2%(which%),y2%(which%)),work%
  171.     PUT (x1%(which%),y1%(which%)),work%,PRESET
  172.     ix%=MOUSE(1) : iy%=MOUSE(2) : RelVerify%=-1
  173.     WHILE MOUSE(0)<>0
  174.         IF MOUSE(1)<>ix% OR MOUSE(2)<>iy% THEN RelVerify%=0
  175.     WEND
  176.     'This line restores the box
  177.     PUT (x1%(which%),y1%(which%)),work%,PSET
  178. END SUB
  179.  
  180. REM TxBox
  181. SUB TxBox(msg$) STATIC
  182. 'TxBox automatically draws a box
  183. 'around text in (msg$), stores box
  184. 'vertices in corner arrays
  185. 'Sub BOX automatically increments
  186. 'global index BoxIndex%
  187.     SHARED x1%(),y1%(),x2%(),y2%()
  188.     SHARED BoxIndex%
  189.     x1%=WINDOW(4) : y1%=WINDOW(5)-10
  190.     PRINT " ";msg$;" ";
  191.     x2%=WINDOW(4) : y2%=y1%+14
  192.     CALL Box(BoxIndex%,x1%,y1%,x2%,y2%)
  193.     BoxIndex%=BoxIndex%+1
  194.     PRINT SPC(1);
  195. END SUB
  196.  
  197. REM Box
  198. SUB Box(i%,x1%,y1%,x2%,y2%) STATIC
  199. 'Draw and store a box (i) whose corner
  200. 'coords are (x1,y1)-(x2,y2)
  201. 'Can be used to change a box's coords
  202.     SHARED x1%(),y1%(),x2%(),y2%()
  203.     IF x2%<x1% THEN SWAP x1%,x2%
  204.     LINE (x1%,y1%)-(x2%,y2%),1-(WINDOW(6)>1),b
  205.     LINE (x1%,y1%)-(x2%-1,y2%-1),2-(WINDOW(6)>1),b
  206.     x1%(i%)=x1% : y1%(i%)=y1% : x2%(i%)=x2% : y2%(i%)=y2%
  207. END SUB
  208.  
  209. REM NoBoxGad
  210. SUB NoBoxGad(i%,x1%,y1%,x2%,y2%) STATIC
  211. 'Same as Box(), but doesn't draw a box
  212.     SHARED x1%(),y1%(),x2%(),y2%()
  213.     IF x2%<x1% THEN SWAP x1%,x2%
  214.     x1%(i%)=x1% : y1%(i%)=y1% : x2%(i%)=x2% : y2%(i%)=y2%
  215. END SUB
  216.  
  217. REM CheckBox
  218. 'Checks a box when selected.  Actually, changes box color and
  219. 'wipes string
  220. SUB CheckBox(i%,flag%) STATIC
  221. 'Check a box
  222. 'Pass variable (flag)
  223. 'for on/off (-1/0)
  224.     SHARED x1%(),y1%(),x2%(),y2%()
  225.     x1%=x1%(i%)+1 : y1%=y1%(i%)+1
  226.     x2%=x2%(i%)-1 : y2%=y2%(i%)-1
  227.     COLOR ,,2
  228.     LINE (x1%+1,y1%+1)-(x2%-1,y2%-1),WINDOW(6)*-(flag%<>0),bf
  229.     COLOR ,,1
  230. END SUB
  231. REM BlankBox
  232. SUB BlankBox(i%) STATIC
  233.     SHARED x1%(),y1%(),x2%(),y2%()
  234.     x1%=x1%(i%)-3 : y1%=y1%(i%)-3
  235.     x2%=x2%(i%)+3 : y2%=y2%(i%)+3
  236.     LINE (x1%+1,y1%)-(x2%,y2%),1,bf
  237. END SUB
  238.  
  239. REM WaitBox
  240. SUB WaitBox(which%) STATIC
  241. 'Wait for a box to be selected
  242. 'return box number in (which%)
  243.     which%=0
  244.     WHILE which%=0
  245.         SLEEP
  246.           CALL WhichBox(which%)
  247.     WEND
  248.     EXIT SUB
  249. END SUB
  250.  
  251. REM WhichBox
  252. SUB WhichBox(which%) STATIC
  253. 'See if a box is selected,
  254. 'otherwise (which%)=0
  255. 'Used to poll for box selection
  256.     SHARED x1%(),y1%(),x2%(),y2%(),BoxIndex%
  257.     IF MOUSE(0)=0 THEN EXIT SUB
  258.     x%=MOUSE(1) : y%=MOUSE(2) : i%=1
  259.     WHILE i%<BoxIndex% AND NOT (x%>x1%(i%) AND x%<x2%(i%) AND y%>y1%(i%) AND y%<y2%(i%))
  260.         INCR i%
  261.     WEND
  262.     which%=i%
  263.     IF i%=BoxIndex% THEN which%=0
  264. END SUB
  265.  
  266. REM GetString
  267. SUB GetString(Xpos%,Ypos%,default$) STATIC
  268. 'Customized GetString integrated for
  269. 'use with other box gadgets
  270. 'Exits when RETURN is pressed or
  271. 'when another button is clicked
  272. '(button selected is returned in
  273. ' global variable which%)
  274. 'Provide your own border.
  275. 'Pass position of field (Xpos%,Ypos%)
  276. 'Pass default prompt in default$,
  277. 'find return in default$
  278. 'global variable maxlen%=length of edit field in characters
  279. '(default length is 40)
  280.     SHARED maxlen%,which%
  281.     answer$=default$
  282.     IF maxlen%=0 THEN maxlen%=40
  283.     'Cursor appears at end of default string
  284.     csr%=LEN(default$)+1
  285.     k$=""
  286.     WHILE k$<>CHR$(13)
  287.             PRINT PTAB(Xpos%+8,Ypos%);default$;" ";
  288.             PRINT PTAB(Xpos%+csr%*8,Ypos%)
  289.             COLOR 0,WINDOW(6) 'cursor is max color
  290.             PRINT MID$(default$+" ",csr%,1)
  291.             COLOR 1,0 : k$=""
  292.           WHILE k$="":k$=INKEY$
  293.             SLEEP
  294.                 CALL WhichBox(i%)
  295.                 IF i%>1 AND i%<>which% THEN which%=i%:k$=CHR$(13)
  296.           WEND
  297.           PRINT PTAB(Xpos%+8,Ypos%);default$;" ";
  298.           k%=ASC(k$)
  299.           IF k%>=32 AND k%<127 THEN  
  300.                 default$=LEFT$(default$,csr%-1)+k$+MID$(default$,csr%)
  301.                 default$=LEFT$(default$,maxlen%)
  302.                 csr%=csr%-(csr%<maxlen%)
  303.           END IF
  304.           IF k%=31 OR k%=8 THEN csr%=csr%+(csr%>1)
  305.           IF k%=127 OR k%=8 THEN
  306.                 default$=LEFT$(default$,csr%-1)+MID$(default$,csr%+1)
  307.           END IF
  308.           IF k%=30 THEN csr%=csr%-(csr%<maxlen%)
  309.     WEND               
  310. END SUB
  311. RETURN
  312.  
  313. REM MakeProp
  314. SUB MakeProp(Xmin%,Ymin%,PropWidth%,PropHeight%,EleDisplayed%,TotNumEls%)
  315. 'Make a proportional gadget
  316. 'Xmin% = Left edge
  317. 'Ymin% = Top edge
  318. 'PropWidth% = width of propgad box
  319. 'PropHeight% = height of propgad box
  320. 'EleDisplayed% = number of elements displayed at one time
  321. 'TotNumEls% = total number of elements in list
  322. '
  323.     SHARED Sheight%,x1%(),y1%(),x2%(),y2%(),BoxIndex%,p%()
  324.     Swidth%=PropWidth%
  325.     Sheight%=EleDisplayed%/TotNumEls%*PropHeight%
  326.     LINE (Xmin%,Ymin%)-(Xmin%+Swidth%,Ymin%+Sheight%),,bf
  327.     GET (Xmin%,Ymin%)-(Xmin%+Swidth%,Ymin%+Sheight%),p%
  328.     LINE (Xmin%-2,Ymin%-2)-(Xmin%+PropWidth%+2,Ymin%+PropHeight%),,b
  329.     x1%(BoxIndex%)=Xmin% : y1%(BoxIndex%)=Ymin%
  330.     x2%(BoxIndex%)=Xmin%+PropWidth% : y2%(BoxIndex%)=Ymin%+PropHeight%
  331.     BoxIndex%=BoxIndex%+1
  332. END SUB
  333.  
  334. REM SliderPos
  335. SUB SliderPos(i%,NewPos%,fl%)
  336. 'Positions proportional gadget slider
  337. 'i% = gadget ID number
  338. 'NewPos% = input/output = position of slider
  339. 'You can get the index value associated with the change in slider position
  340. ' by using the following line:
  341. ' l%=INT((pos%-y%)/(Pheight%-Sheight%-2)*(TotNumEls%-NumElsDisplayed%))
  342. ' which is placed in the intuition message loop.
  343. ' 
  344.     SHARED Sheight%,x1%(),y1%(),x2%(),y2%(),p%()
  345.     PUT (x1%(i%),NewPos%),p%
  346.     IF fl%=1 THEN
  347.         NewPos%=MOUSE(2)
  348.     ELSEIF fl%=0 THEN
  349.         INCR NewPos%
  350.     ELSEIF fl%=-1 THEN
  351.         DECR NewPos%
  352.     END IF
  353.     IF NewPos% > y2%(i%)-Sheight%-2 THEN NewPos%=y2%(i%)-Sheight%-2
  354.     IF Newpos% < y1%(i%) THEN NewPos%=y1%(i%)
  355.     PUT (x1%(which%),Newpos%),p%
  356. END SUB    
  357.  
  358. REM InverseSelect
  359. SUB InverseSelect(ID%,Xmin%,Ymin%,Height%,Width%,dly!)
  360. 'Similar to CheckBox() but is usable on any selected area of window
  361. 'ID% is an indentification number usable for gadgets. If not needed pass 1
  362. 'Xmin% is left side of select box
  363. 'Ymin% is top of select box
  364. 'Height% is height of area in pixels
  365. 'Width% is width of area in pixels
  366. 'dly! is delay passed to Delay() subroutine
  367. '
  368.     COLOR ,,2:LINE (Xmin%+2,Ymin%+ID%*Height%-4)-(Xmin%+Width%-2,Ymin%-7+ID%*Height%+Height%),,bf
  369.     COLOR ,,1
  370.     CALL Delay(dly!)
  371. END SUB
  372.